COMMENT ⊗   VALID 00006 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		TITLE LISTFONT
C00005 00003	BEGIN LOOP
C00012 00004	NSUBR PUTCHR,CHAR
C00013 00005	NSUBR(GETFIL)GET FILE SPEC FROM TTY LINE 
C00015 00006	DATA AREA
C00016 ENDMK
C⊗;
	TITLE LISTFONT

IFNDEF DEBUG,<↓DEBUG←0
>

START:	MOVE P,[IOWD PLEN,PLIST]
	RESET
	INIT 17				;READ IN FONT FILE
	SIXBIT/DSK/
	0
	FATAL(CAN'T INIT DSK)
START2:	OUTSTR[ASCIZ/FONT FILE = /]
	CALL(GETFIL)
	EXIT
	LOOKUP FILNAM
	GO [ HLLZ EXTION
	     JUMPE [ MOVSI 'FNT'
		     MOVEM EXTION
		     LOOKUP FILNAM
		     GO NOEXT
		     GO LOOKOK]
     NOEXT:  SKIPE PPPN
	     GO [ NOTFND: OUTSTR[ASCIZ/FILE NOT FOUND.
/]↔			  GO START2 ]
	     MOVE [SIXBIT/FNTTVR/]
	     MOVEM PPPN
	     SETZ
	     GETPPN
	     ANDI 777777
	     CAIN 'TVR'
	     LOOKUP FILNAM
	     GO [ MOVE [SIXBIT/XGPSYS/]
		  MOVEM PPPN
		  LOOKUP FILNAM
		  GO NOTFND
		  GO LOOKOK]
	     GO LOOKOK]
LOOKOK:	HLRE PPPN			;GET SOME CORE FOR FONT FILE
	MOVN
	ADD JOBFF
	PUSH P,
	CORE
	FATAL(NOT ENOUGH CORE!)
	MOVE JOBFF
	MOVEM BUFPTR
	POP P,JOBFF
	SUBI 1
	HLL PPPN
	SETZ 1,
	IN 0
	SKIPA
	FATAL(READ ERROR?)
	RELEASE 0,
	INIT 1,				;SETUP OUTPUT FILE
	SIXBIT/DSK/
	OHDR,,0
	FATAL(CAN'T INIT DSK)
	ENTER 1,[SIXBIT/QQFLISRPG/↔0↔0]
	FATAL(CAN'T WRITE OUTPUT FILE!)
	SETOM TOPTAB
	MOVE [XWD TOPTAB,TOPTAB+1]
	BLT TOPTAB+177
	OUTSTR[ASCIZ/OPTION(L-LPT,T-TTY,X-XGP)?/]
	SETZ 1,
	INCHRW
	ANDI 137
	CAIN "L"
	MOVEI 1,1
	CAIN "X"
	MOVEI 1,2
	MOVEM 1,OUTYPE#
	MOVE [=72↔=120↔=1400/6](1)
	MOVEM XMAX
	SETZM LPTSW
	CAIN 1,1
	SETOM LPTSW#
	SETZM XGPSW
	CAIN 1,2
	SETOM XGPSW#
	OUTSTR[ASCIZ/
/]
BEGIN LOOP
	ACCUMULATORS{CHAR1,CHARX,X,Y,BUF,ADR}
	DEFINE OUTFIL(CHAR)
<	SOSG OHDR+2
	OUT 1,
	SKIPA
	FATAL(WRITE ERROR!)
	IDPB CHAR,OHDR+1
IFN DEBUG,<OUTCHR CHAR
>>
	MOVE BUF,BUFPTR
	HRLI BUF,CHARX
	SOS 203(BUF)		;FUDGE FACTOR
	INSKIP			;IF NO TYPE AHEAD THEN
	OUTSTR 240(BUF)		;TYPE THE DESCRIPTION
	OUTSTR[ASCIZ/
/]				;JUST IN CASE THERE WASN'T ONE IN DESCRPITION
	SETZ CHAR1,
MAIN:	SETZ Y,			;THE MAIN LOOP
	CALL(BOARDER)
YLOOP:	JUMPE Y,YL1
	CALL(PUTCHR,[15])
	SKIPN LPTSW
	GO [CALL(PUTCHR,[12])
	    GO YL1]
	CALL(PUTCHR,[177])
	CALL(PUTCHR,[21])
YL1:	CAMLE Y,201(BUF)		;THIS GROUP OF CHARACTERS DONE YET?
	GO [ CAIL CHARX,200		;YES, ARE WE DONE WITH FONT?
	     GO [ RELEASE 1,
		  MOVE 1,OUTYPE
		  PTWRS7 @[[ 0↔[ASCIZ/TRAN TTY:←QQFLIS.RPG/](1)]
		  	   [ 0↔[ASCIZ"SPOOL QQFLIS.RPG/B/D"]]
		  	   [ 0↔[ASCIZ"TRAN XGP:←QQFLIS.RPG/FONT=LISTFONT[FNT,TVR]/EXTRA≡0"]]](1)
		  EXIT ]
	     MOVE CHAR1,CHARX	;SET CHAR1 TO FIRST OF NEXT GROUP
	     GO MAIN ]		;DO NEXT GROUP
	CAME Y,201(BUF)		;TIME TO DO BOTTOM LINE OR
	CAMN Y,203(BUF)		;TIME TO DO THE BASE LINE?
	CALL(BASELINE)		;YEP
	SETZ X,
	MOVE CHARX,CHAR1	;THE ROW LOOP
CLOOP:	HRRZ ADR,@BUF		;THE CHARACTER LOOP
	JUMPE ADR,[AOJA CHARX,CLOOP]	;SKIP UNDEF CHARACTER
	ADDI ADR,(BUF)
	CALL(PUTCHR,["|"])	;OUTPUT BOARDER
	CAIL CHARX,200		;END TEST
	AOJA Y,YLOOP		;THIS ROW DONE
	HLRE 1,@BUF		;GET WIDTH
	ADDI X,1(1)		;ADD WIDTH+1 TO X
	CAMLE X,XMAX		;TOO BIG?
	GO [ CAIN X,1(1)		;YES, IS CHARACTER TOO BIG
	     FATAL(CHARACTER TOO WIDE!)	;LOSE BIG
	     AOJA Y,YLOOP ]		;THIS ROW DONE
	SKIPGE 1,TOPTAB(CHARX)	;ARE WE SET UP FOR THIS ROW?
	JUMPL 1,[ HLRZ (ADR)		;NO, DO SETUP
		  CAME CHARX		;A LITTLE BIT OF CHECKING...
		  GO [ OUTSTR[ASCIZ/BAD FONT FILE. ADDRESS TABLE INVALID.
FIRST LOSING CHARACTER = '/]
		       OUTCHR CHARX
		       OUTCHR ["'"]
		       EXIT 1,
		       GO $.-1]
		  HLRE 1,1(ADR)		;SETUP TOP COUNT
		  MOVEM 1,TOPTAB(CHARX)
		  HRRE 0,1(ADR)		;SETUP ROW COUNT
		  MOVEM 0,ROWTAB(CHARX)
		  ADD 0,1
		  CAMLE 0,201(BUF)	;SOME MORE CHECKING
		  GO [ OUTSTR[ASCIZ/TOP_COUNT+ROW_COUNT>MAXHEIGHT.  CHARACTER = '/]
		       OUTCHR CHARX
		       OUTSTR[ASCIZ/'
/]↔		       GO CL1 ]
	     CL1: HRRZ 0,ADR		;SET UP BYTE POINT
		  ADD 0,[POINT 1,2,-1]
		  MOVEM 0,PTRTAB(CHARX)
		  MOVEI 0,=36		;CALCULATE BYTES/WORD
		  HLRE 1,@BUF
		  IDIV 0,1
		  MOVEM 0,BYTTAB(CHARX)	;SAVE IT
		  MOVEM 0,REMTAB(CHARX)	;SET UP BYTES REMAINING TOO
		  MOVE 1,TOPTAB(CHARX)
		  GO CL2 ]
CL2:	HLRE 0,@BUF		;SETUP TO DO COLUMN LOOP
	JUMPG 1,[ SOS TOPTAB(CHARX)	;STILL ON TOP OF CHARACTER
		  GO BLANK ]		;A BLANK LINE FOR THIS CHARACTER
	SOSGE ROWTAB(CHARX)	;ANYTHING LEFT IN THIS CHARACTER?
	GO BLANK		;NO
XLOOP:	ILDB 1,PTRTAB(CHARX)
	MOVE 1,[" "↔"*"](1)
	OUTFIL 1
;	CALL(PUTCHR,<[" "↔"*"](1)>)
	SOJG 0,XLOOP
	SOSLE REMTAB(CHARX)	;IS WORD EXHAUSTED?
	AOJA CHARX,CLOOP	;NO
	MOVE 1,BYTTAB(CHARX)	;YES, RESET BYTES REMAINING
	MOVEM 1,REMTAB(CHARX)
	MOVSI 1,770000		;SET POINTER TO NEXT WORD BOUNDARY
	ANDCAM 1,PTRTAB(CHARX)
	AOJA CHARX,CLOOP	;DO NEXT CHARACTER
BLANK:	MOVEI 1," "
	OUTFIL 1
	SOJG 0,BLANK+1
;	CALL(PUTCHR,[" "])	;PUT OUT A BLANK ROW
;	SOJG 0,BLANK
	AOJA CHARX,CLOOP	;DO NEXT CHARACTER

NSUBR BASELINE
;CLOBBERS 0,1
;CALL PUTCHR
	GLOBAL CHARX,CHAR1,ADR,X
	MOVE CHARX,CHAR1	;THE ROW LOOP
	SETZ X,
CLOOP:	HRRZ 1,@BUF		;THE CHARACTER LOOP
	JUMPE 1,[AOJA CHARX,CLOOP]	;SKIP UNDEF CHARACTER
	CAIL CHARX,200		;END TEST
	GO CFIN			;THIS ROW DONE
	HLRE 1,@BUF		;GET WIDTH
	ADDI X,1(1)		;ADD WIDTH+1 TO X
	CAMLE X,XMAX		;TOO BIG?
	GO [ CAIN X,1(1)		;YES, IS CHARACTER TOO BIG
	     FATAL(CHARACTER TOO WIDE!)	;LOSE BIG
	     GO CFIN ]		;THIS ROW DONE
	MOVE 0,X
	AOJA CHARX,CLOOP
CFIN:	CALL(PUTCHR,[" "])
	SKIPE XGPSW
	GO [ CALL(PUTCHR,[177])
	     CALL(PUTCHR,[1])
	     CALL(PUTCHR,[41])
	     CALL(PUTCHR,[6])
	     SUBI 0,1
	     IMULI 0,6
	     MOVE 1,0
	     ASH 1,-7
	     CALL(PUTCHR,1)
	     CALL(PUTCHR,0)
	     CALL(PUTCHR,[15])
	     POP0J]
	MOVEI 1,"_"
CL2:	SOJLE 0,[ CALL(PUTCHR,[15])
		  POP0J]
;	CALL(PUTCHR,["_"])
	OUTFIL 1
	GO CL2
SUBREND BASELINE

NSUBR BOARDER
;CALL BASELINE,PUTCHR
	CALL(BASELINE)
	SKIPN LPTSW
	GO [CALL(PUTCHR,[12])
	    POP0J]
	CALL(PUTCHR,[177])
	CALL(PUTCHR,[21])
	POP0J
SUBREND BOARDER
BEND LOOP
NSUBR PUTCHR,CHAR
;AC TRANSPARENT
;DOES NOT CALL ANYTHING
	SOSG OHDR+2
	OUT 1,
	GO PUTCH2
	FATAL(WRITE ERROR?)
PUTCH2:	EXCH CHAR
	IDPB OHDR+1
	EXCH CHAR
IFN DEBUG,<OUTCHR CHAR
>
	POP1J]
SUBREND PUTCHR
NSUBR(GETFIL)GET FILE SPEC FROM TTY LINE 

	SETZM FILNAM↔SETZM EXTION
	SETZM EXTION+1↔SETZM PPPN
;	CRLF
	MOVE 4,[POINT 6,FILNAM,-1]↔MOVEI 2,6
	INCHWL 1↔CAIN 1,15↔GO[INCHWL↔POP0J]↔AOS(P)
	JRST L+1
L:	INCHWL 1
	CAILE 1,"z"↔POP0J
	CAIL 1,"a"↔SUBI 1,40		;CONVERT LOWER CASE
	CAIN 1,"."↔GO[MOVE 4,[POINT 6,EXTION,-1]↔MOVEI 2,3↔GO L]
	CAIN 1,"["↔GO[MOVE 4,[POINT 6,PPPN,-1]  ↔MOVEI 2,3↔GO L]
	CAIN 1,","↔GO[HLRZ PPPN
		      PUSHJ P,[PPJUST:	JUMPE [OUTSTR[ASCIZ/BAD P,PN/]
						CLRBFI↔SOS -1(P)↔CRLF↔POP1J]	
		   	 		TRNE 77↔POP0J↔LSH -6↔GO PPJUST]
		      HRLM PPPN↔MOVE 4,[POINT 6,PPPN,17]↔MOVEI 2,3↔GO L]
	CAIN 1,"]"↔GO[HRRZ PPPN↔CALL(PPJUST)
		   HRRM PPPN↔INCHWL 1↔GO FINQ]
FINQ:	CAIN 1,15↔GO EOL			;END OF THE LINE.
	CAIN 1,12↔POP0J
;	CAIN 1,"→"↔POP0J
	CAIG 1," "↔GO L	;IGNORE GARBAGE.
	SOJL 2,L↔SUBI 1,40↔IDPB 1,4↔GO L

EOL:	INCHWL 1↔POP0J
SUBREND GETFIL;1/31/73(BGB),2/7/73(TVR)
;DATA AREA

PLIST:	BLOCK 20	;PUSHDOWN LIST
PLEN←←.-PLIST

TOPTAB:	BLOCK 200	;TABLE OF COUNT FROM TOP
ROWTAB:	BLOCK 200	;TABLE OF ROWS REMAINDER
PTRTAB:	BLOCK 200	;BYTE POINTER FOR EACH CHARACTER
BYTTAB:	BLOCK 200	;BYTES/WORD FOR EACH CHARACTER
REMTAB:	BLOCK 200	;NUMBER OF BYTES REMAINDING IN A WORD

BUFPTR:	BLOCK 1

OHDR:	BLOCK 3

XMAX:	=120

FILNAM:	BLOCK 1
EXTION:	BLOCK 2
PPPN:	BLOCK 2

	TAIL
END START